home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 10 - 1994 / 10.10 Oct 94 / Learning Smalltalk / WireList.st next >
Encoding:
Text File  |  1994-09-13  |  13.4 KB  |  245 lines  |  [TEXT/QKSA]
  1.  
  2. DemoLib
  3.              name: #WireList
  4.        superclass: Environment@#List
  5.             flags: 0x80000
  6.          category: #'WireList Example'
  7. classInstanceVars: nil
  8. namedInstanceVars: #(first second)
  9.     classPoolVars: nil
  10.             pools: nil
  11.        structures: nil
  12.       storageSize: 0
  13. !
  14. (DemoLib@#WireList) metaclass description: (Text from: 'This class holds the data structures for the WireListModel. It''s protocol supports the algorithmics for the WireListModel.' styleRuns:((ScrapStyle basicNew: 0) storageSize: 22; storageFromHexString: '000100000000000C000A000100000009000000000000'))!
  15. DemoLib@#WireList compileMethodSource: (
  16. Text from: 'add: aPoint
  17.  
  18.    " add a point to the end of the list"
  19.    
  20.     (self setToEnd) nextPut: aPoint.
  21.     
  22.     ' styleRuns:((ScrapStyle basicNew: 0) storageSize: 62; storageFromHexString: '000300000000000B000900040000000900000000000000000010000B000900040000000999996666000000000035000B0009000400000009000000000000'))!
  23. (DemoLib@#WireList methodAt: #'add:') protocolCategory: #'accessing'.!
  24. (DemoLib@#WireList methodAt: #'add:') description: ('Adds a point to the list').!
  25.  
  26. DemoLib@#WireList compileMethodSource: (
  27. Text from: 'second
  28.  
  29.     "second element accessor; not used in WireListModel"
  30.     ^self position:1; next
  31.     ' styleRuns:((ScrapStyle basicNew: 0) storageSize: 62; storageFromHexString: '000300000000000B00090004000000090000000000000000000C000B000900040000000999996666000000000040000B0009000400000009000000000000'))!
  32. (DemoLib@#WireList methodAt: #'second') protocolCategory: #'accessing'.!
  33.  
  34. DemoLib@#WireList compileMethodSource: (
  35. Text from: 'first
  36.  
  37.     "First element accessor; not used in WireListModel"
  38.  
  39.     ^self reset; peek' styleRuns:((ScrapStyle basicNew: 0) storageSize: 62; storageFromHexString: '000300000000000B00090004000000090000000000000000000B000B00090004000000099999666600000000003E000B0009000400000009000000000000'))!
  40. (DemoLib@#WireList methodAt: #'first') protocolCategory: #'accessing'.!
  41. (DemoLib@#WireList methodAt: #'first') description: ('Access the first element in list. NOT USED for WireListModel').!
  42.  
  43. DemoLib@#WireList compileMethodSource: (
  44. Text from: 'drawNode: p
  45.  
  46.     " draws little circles 5 pixels diam. to represent points selected"
  47.     
  48.     (Oval top: ((p y) - 5) left: ((p x) - 5) bottom: ((p y) + 5) right: ((p x) + 5)) frame.' styleRuns:((ScrapStyle basicNew: 0) storageSize: 62; storageFromHexString: '000300000000000B000900040000000900000000000000000012000B000900040000000999996666000000000055000B0009000400000009000000000000'))!
  49. (DemoLib@#WireList methodAt: #'drawNode:') protocolCategory: #'drawing'.!
  50. (DemoLib@#WireList methodAt: #'drawNode:') description: ('This draws the node shape that represents the wire point. (used for 2nd point on)').!
  51.  
  52. DemoLib@#WireList compileMethodSource: (
  53. Text from: 'shorten
  54.     
  55. "Try random changes in the routing order.  Keep
  56.      only changes that shorten the length."
  57.     
  58. |  minLength i j |
  59.     
  60. "set the current length to the first guess at the minimum"
  61.     minLength := self length.
  62.     
  63. "Randomly generate integers and exchange them two at a time. Keep the order with the 
  64.  smallest length on each trial"
  65.  
  66. 100 "<-- Arbitrary number guess of trials to reach min. This should really be scaled
  67.      to change with number of elements; e.g. might try (self size * 20) instead"
  68.         timesRepeat:
  69.             [i := ((Float random * self size) truncate + 1)asInteger. " see WireListModel class NOTES caveats"
  70.             j := ((Float random * self size) truncate + 1)asInteger.
  71.             self exchange: i and: j.
  72.             self length < minLength             
  73.                 ifTrue: [minLength := self length]
  74.                 ifFalse: [self exchange: i and: j]]' styleRuns:((ScrapStyle basicNew: 0) storageSize: 222; storageFromHexString: '000B00000000000B00090004000000090000000000000000000A000B000900040000000999996666000000000062000B00090004000000090000000000000000007A000B0009000400000009999966660000000000B4000B0009000400000009000000000000000000D2000B000900040000000999996666000000000149000B00090004000000090000000000000000014E000B0009000400000009999966660000000001EF000B00090004000000090000000000000000023C000B000900040000000999996666000000000264000B0009000400000009000000000000'))!
  75. (DemoLib@#WireList methodAt: #'shorten') protocolCategory: #'calculating'.!
  76. (DemoLib@#WireList methodAt: #'shorten') description: ('The primary algorithm to compute the shortest path between points. This is a sotchastic approx. or Monte Carlo based algorithm, and cannot be guaranteed to produce true minima in all cases.').!
  77.  
  78. DemoLib@#WireList compileMethodSource: (
  79. Text from: 'length
  80.     "Answer the length of the wire."
  81.     | total previous |
  82.     total := 0.
  83.     self position: 0.
  84.     previous :=  self next.
  85.     self
  86.         do:
  87.             [:next |
  88.             total := total + (((previous x - next x) squared) + ((previous y - next y) squared)) squareRoot.
  89.             previous := next].
  90.  
  91.     ^total
  92.     ' styleRuns:((ScrapStyle basicNew: 0) storageSize: 62; storageFromHexString: '000300000000000B000900040000000900000000000000000008000B000900040000000999996666000000000028000B0009000400000009000000000000'))!
  93. (DemoLib@#WireList methodAt: #'length') protocolCategory: #'calculating'.!
  94. (DemoLib@#WireList methodAt: #'length') description: ('This computes the length of the wire.').!
  95.  
  96. DemoLib@#WireList compileMethodSource: (
  97. Text from: 'exchange: index1 and: index2
  98.     
  99. "Exchange the elements at the first and second indexes."
  100.  
  101.     | temp |
  102.     temp := self at: index1.
  103.     self at: index1 put: (self at: index2).
  104.     self at: index2 put: temp
  105.     ' styleRuns:((ScrapStyle basicNew: 0) storageSize: 62; storageFromHexString: '000300000000000B00090004000000090000000000000000001F000B000900040000000999996666000000000057000B0009000400000009000000000000'))!
  106. (DemoLib@#WireList methodAt: #'exchange:and:') protocolCategory: #'accessing'.!
  107.  
  108. DemoLib@#WireList compileMethodSource: (
  109. Text from: 'drawOn: wPort
  110.  
  111.     "This is the primary routine used to draw the nodes and connecting lines
  112.     representing the wire."
  113.  
  114.     | p pBnds|
  115.     
  116.     " make a copy of the bounds because some bounds methods are destructive"
  117.     pBnds := wPort bounds.
  118.     
  119.     " set up the clipping region to be inside the framed rectangle; try commenting this out 
  120.       to see what happens"
  121.    wPort clipRect: (Rectangle top: pBnds top + 34 left: pBnds left + 14 bottom: pBnds bottom -14                              
  122.         right: pBnds right - 14 ).
  123.         
  124.     "check that  there is something to draw"
  125.     ((self size) > 0)
  126.         ifFalse: [ ^nil ].
  127.  
  128.     " draw the black node for the first"
  129.     self drawNodeFirst: (self at: 1).
  130.     wPort movePenTo: (self at: 1).
  131.             
  132.    "now draw the remaining ones"
  133.      2 to: (self size) do: [ :i |
  134.         p := (self at: i).
  135.         wPort drawLineToX: (p x) Y: (p y).
  136.         self drawNode: p.
  137.     ].' styleRuns:((ScrapStyle basicNew: 0) storageSize: 262; storageFromHexString: '000D00000000000B000900040000000900000000000000000013000B000900040000000999996666000000000077000B000900040000000900000000000000000091000B0009000400000009999966660000000000D9000B0009000400000009000000000000000000FE000B000900040000000999996666000000000171000B000900040000000900000000000000000221000B000900040000000999996666000000000249000B000900040000000900000000000000000280000B0009000400000009999966660000000002A4000B0009000400000009000000000000000002FE000B00090004000000099999666600000000031B000B0009000400000009000000000000'))!
  138. (DemoLib@#WireList methodAt: #'drawOn:') protocolCategory: #'drawing'.!
  139. (DemoLib@#WireList methodAt: #'drawOn:') description: ('Draws the points and connecting lines.').!
  140.  
  141. DemoLib@#WireList compileMethodSource: (
  142. Text from: 'drawNodeFirst: p
  143.  
  144.     " same as drawNode: but fills the region; it is used only for first point"
  145.     
  146.     (Oval top: ((p y) - 5) left: ((p x) - 5) bottom: ((p y) + 5) right: ((p x) + 5)) fill: Pattern black.' styleRuns:((ScrapStyle basicNew: 0) storageSize: 62; storageFromHexString: '000300000000000B000900040000000900000000000000000017000B000900040000000999996666000000000061000B0009000400000009000000000000'))!
  147. (DemoLib@#WireList methodAt: #'drawNodeFirst:') protocolCategory: #'drawing'.!
  148. (DemoLib@#WireList methodAt: #'drawNodeFirst:') description: ('Draws the node shape representing the first point selected.').!
  149.  
  150. DemoLib@#WireList compileMethodSource: (
  151. Text from: 'distance: indx to: p
  152.  
  153.     " compute the Euclidean distance between points"
  154.  
  155.     ^( ((self at: indx) x - p x) squared + ((self at: indx) y - p y) squared) squareRoot' styleRuns:((ScrapStyle basicNew: 0) storageSize: 62; storageFromHexString: '000300000000000B00090004000000090000000000000000001A000B00090004000000099999666600000000004A000B0009000400000009000000000000'))!
  156. (DemoLib@#WireList methodAt: #'distance:to:') protocolCategory: #'calculating'.!
  157. (DemoLib@#WireList methodAt: #'distance:to:') description: ('Computes Euclidean distance between points. This really belongs in the class Co-ordinate. It is included hereonly to keep the demo self contained.').!
  158.  
  159. DemoLib@#WireList compileMethodSource: (
  160. Text from: 'drawRubberBandWith: index on: wPort
  161.  
  162.     "This method is used to draw ''rubber band'' representations when user moves a point"
  163.     | oldMode oldColor p1 p2 m1 m2 |
  164.  
  165.     "make sure the right window port is at top of the thread stack; we will be changing
  166.     pen colors in this method"
  167.     thread pushGPort: wPort.
  168.     
  169.     " draw the wires and nodes"  
  170.     ((self size) > 0)
  171.         ifFalse: [ ^nil ].
  172.  
  173.     self drawOn: wPort.
  174.         
  175.     "is this the first point? if not set the temporary point (p1) to the one just before the
  176.      one at position, index"
  177.     (index = 1)
  178.         ifTrue:  [ p1 := self at: 1 ]
  179.         ifFalse: [ p1 := self at: (index - 1) ].
  180.     "is this the last point? if not set the temporary point (p1) to the one just after the
  181.      one at position, index"
  182.     (index = (self size))
  183.         ifTrue:  [ p2 := self at: (self size) ]
  184.         ifFalse: [ p2 := self at: (index + 1) ].
  185.  
  186.     "save the pen mode and color so we can restore them later"
  187.     oldMode := wPort penMode.
  188.     oldColor := wPort penFgColor.
  189.     
  190.    "set the pen to red; draw a red line from p1 to point specified by index to p2"
  191.     wPort penFgColor: Color red.
  192.     wPort movePenTo: p1.
  193.     wPort drawLineToX: ((self at: index) x) Y: ((self at: index) y).
  194.     self drawNode: (self at: index).
  195.     wPort drawLineToX: (p2 x) Y: (p2 y).
  196.     
  197.    "change the pen to blue while the point is being dragged"
  198.     wPort penFgColor: Color blue.
  199.     wPort penMode: #patXor. "<-- try commenting this out to see what happens"
  200.     
  201.     "set m1 to local mouse position but don''t do anything while the user just holds the
  202.      button down but not moving"
  203.     [ m1 := Mouse localPosition.  (m1 = Mouse localPosition) and: (Mouse isButtonDown) ] 
  204.         whileTrue: [].
  205.         
  206.      "while the button is down..."   
  207.     [Mouse buttonsDown]
  208.         whileTrue: [ 
  209.             "if the mouse is on the first or last point, draw a line from that point to
  210.             new mouse position"
  211.             (index = 1) ifTrue: [ p1 := m1 ].
  212.             (index = (self size)) ifTrue: [ p2 := m1 ].
  213.             wPort movePenTo: p1.
  214.             wPort drawLineToX: (m1 x) Y: (m1 y).
  215.             self drawNode: m1.
  216.             wPort drawLineToX: (p2 x) Y: (p2 y).
  217.             
  218.             "do nothing if mouse is not moved"
  219.             [ m2 := Mouse localPosition.  (m1 = m2) and: (Mouse isButtonDown) ] whileTrue: [].
  220.             
  221.             "draw the line each time the mouse moves, and set m1 to local position;
  222.              this drawing is done in Xor pattern to produce a clean line for each move"
  223.             wPort movePenTo: p1.
  224.             wPort drawLineToX: (m1 x) Y: (m1 y).
  225.             self drawNode: m1.
  226.             wPort drawLineToX: (p2 x) Y: (p2 y).
  227.             
  228.             (Mouse isButtonDown) ifTrue: [ m1 := m2 ].
  229.         ].
  230.      
  231.      "draw the new node position and lines when the button is released"      
  232.     wPort movePenTo: p1.
  233.     wPort drawLineToX: (m1 x) Y: (m1 y).
  234.     self drawNode: m1.
  235.     wPort drawLineToX: (p2 x) Y: (p2 y).
  236.     
  237.     "reset the penMode, color and pop the GPort"
  238.     wPort penMode: oldMode.
  239.     wPort penFgColor: oldColor.
  240.     thread popGPort.
  241.     ' styleRuns:((ScrapStyle basicNew: 0) storageSize: 662; storageFromHexString: '002100000000000B000900040000000900000000000000000029000B00090004000000099999666600000000007C000B0009000400000009000000000000000000A8000B00090004000000099999666600000000011A000B000900040000000900000000000000000141000B00090004000000099999666600000000015C000B0009000400000009000000000000000001B6000B00090004000000099999666600000000022B000B000900040000000900000000000000000297000B00090004000000099999666600000000030A000B00090004000000090000000000000000038B000B0009000400000009999966660000000003C5000B00090004000000090000000000000000040E000B00090004000000099999666600000000045D000B000900040000000900000000000000000533000B00090004000000099999666600000000056C000B0009000400000009000000000000000005AB000B0009000400000009999966660000000005DC000B0009000400000009000000000000000005E6000B00090004000000099999666600000000065A000B0009000400000009000000000000000006DA000B0009000400000009999966660000000006F7000B000900040000000900000000000000000735000B0009000400000009999966660000000007A0000B0009000400000009000000000000000008C2000B0009000400000009999966660000000008E4000B00090004000000090000000000000000095D000B0009000400000009999966660000000009FC000B000900040000000900000000000000000AF9000B000900040000000999996666000000000B3B000B000900040000000900000000000000000BCD000B000900040000000999996666000000000BF9000B0009000400000009000000000000'))!
  242. (DemoLib@#WireList methodAt: #'drawRubberBandWith:on:') protocolCategory: #'drawing'.!
  243. (DemoLib@#WireList methodAt: #'drawRubberBandWith:on:') description: ('Method to draw rubber banding of wires. Used to move points around interactively.').!
  244.  
  245.